This script will add a Model Subset that contains only Tables that are involved in a relation (no pun intended)..
To run it: 
1) Create an empty Model Subset (create a new Model Subset and immediately click Finish in the wizard).
2) bring up the Script Explorer (click the Script Explorer tab at the bottom tab of the Model Explorer)
3) right click on "User Defined" and select "New Script" 
4) copy/paste the attachment into the edit control 
 5) change line 37 of the script to the name of the new Model Subset.
6) hit the run button (the first icon in the toolbar above the edit control)   The output will diisplay the Tables that were added to the Model Subset.  
Note: you can undo/redo the effects of this script as with any Model changes
 /************* start of script *************/ 

Function FindChild(Owner, ChildTypes, ChildName)
	Set Children = Owner.Children(ChildTypes)
	For Each Child In Children
		If Child.Property("Name").AsString = ChildName Then
			Set FindChild = Child
			Exit Function
		End If
	Next
	Set FindChild = Nothing
End Function

Function TableIsAttached(Table, AttachedTables)
	TableIsAttached = False
	If Not AttachedTables.HasProperty("Attached Objects") Then
		Exit Function
	End If
	For Each AttachedProp in AttachedTables.Property("Attached Objects").AsVector
		Set AttachedTable = AttachedProp.AsObject
		If Table.Equals(AttachedTable) Then
			TableIsAttached = True
			Exit Function
		End If
	Next
End Function

Function IsParentToRelations(Table)
	If Not Table.HasProperty("Parent To Relations") Then
		IsParentToRelations = False
	Else
		For Each RelProp in Table.Property("Parent To Relations").AsVector
			Set Rel = RelProp.AsObject
			If Rel.TypeName = "Relation" Then
				IsParentToRelations = True
				Exit Function
			End If
		Next
	End If
End Function

Sub Evaluate_OnLoad()
	Set Context = CreateObject("SCF.ScriptContext")
	Set Document = Context.ScriptDocument
	Set ThisScript = Context.Object
	Set Model = ThisScript.Model
	Set ModelObj = Model.AsObject
	Set Framework = CreateObject("SCF.ScriptFramework")
	Model.BeginTransaction("Add Tables to Model Subset")
	ToModelSubsetName = "Model Subset 2"
	Set ModelSubset = FindChild(Model.AsObject, "Model Subset", ToModelSubsetName)
	Set AttachedTables = Nothing
	For Each AttachedType In ModelSubset.Children("Attached Type")
		If AttachedType.Property("Object Type").AsString = "6" Then
			Set AttachedTables = AttachedType
			Exit For
		End If
	Next
	If AttachedTables Is Nothing Then
		Set AttachedTables = Framework.CreateObject("Attached Type", ModelSubset)
		Set PropValue = Framework.CreatePropertyValue("Attached Type", "Object Type")
		PropValue.FromInteger(6)
		Call AttachedTables.SetProperty("Object Type", PropValue)
	End If
	For Each Table In ModelObj.Children("Table")
		If IsParentToRelations(Table) Or Table.HasChildrenByType("Relation") Then
			If Not TableIsAttached(Table, AttachedTables) Then
				Document.Write(Table.Name & vbLf)
				Set PropValue = Framework.CreatePropertyValue("Type", "Column Default")
				PropValue.FromObject(Table)
				Call AttachedTables.SetProperty("Attached Objects", PropValue)
			End If
		End If
	Next
	Model.EndTransaction()
End Sub